home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / bbs_util / cdesc110.zip / ARCID.PAS next >
Pascal/Delphi Source File  |  1996-04-12  |  7KB  |  240 lines
  1. {$N-,E- no math support needed}
  2. {$X- function calls may not be discarded}
  3. {$I- disable I/O checking (trap errors by checking IOResult)}
  4.  
  5. UNIT ArcID;
  6.  
  7. (* A Pascal unit which will determine most major archive types.
  8.    To use this unit, simply define a VAR of ARCTYPE, and then
  9.    call the function as follows:
  10.  
  11.    VAR FileID : ARCTYPE;
  12.  
  13.    FileID := IsArc (FileName.Ext);
  14.    CASE FileID OF
  15.      NONE : Writeln ('Unknown');
  16.      ZIP : Writeln ('ZIP');
  17.      ARC : Writeln ('ARC');
  18.      ... etc.
  19.    END;
  20.  
  21. Returns NONE if unable to identify, otherwise one of these:
  22.   ACB, AIN, ARC, ARJ, HA,  HAP, HPK, HYP, JRC, LIB,
  23.   LIM, LZH, LZS, PAK, PAQ, PUT, RAR, SAR, SQZ, UC2,
  24.   YC,  ZIP, ZOO
  25.  
  26.  
  27. Credit: Many of the ID strings came from GUS (General Unpack Shell).
  28. *)
  29. INTERFACE
  30.  
  31. TYPE
  32.  ARCTYPE =
  33.   (NONE,ACB,AIN,ARC,ARJ,HA,HAP,HPK,HYP,JRC,LIB,LIM,LZH,LZS,PAK,PAQ,PUT,RAR,SAR,SQZ,UC2,YC,ZIP,ZOO);
  34.  
  35. FUNCTION IsArc (FName : STRING) : ARCTYPE;
  36.  
  37. IMPLEMENTATION
  38.  
  39. VAR
  40.   IDStrh: STRING;
  41.  
  42. FUNCTION Byte_To_Hex(X : byte) : String;
  43. CONST
  44.   Digits : array [0..15] of char = '0123456789ABCDEF';
  45.  
  46. BEGIN { Byte_To_Hex }
  47.   Byte_To_Hex := Concat(Digits[X shr 4],Digits[X and 15]);
  48. END; { Byte_To_Hex }
  49.  
  50. FUNCTION StrToHex (str: STRING; len: BYTE): STRING;
  51. VAR
  52.   NewStr : STRING;
  53.   Index : WORD;
  54. BEGIN
  55.   NewStr := '';
  56.   For Index := 1 to len DO
  57.     NewStr := NewStr + Byte_To_Hex (Ord (str [Index]));
  58.   StrToHex := NewStr;
  59. END;
  60.  
  61. FUNCTION CheckID (Offset: BYTE; IDhex: STRING): BOOLEAN;
  62. BEGIN
  63.   CheckID := Copy (IDStrh, Offset, Length (IDhex)) = IDhex;
  64. END;
  65.  
  66. FUNCTION IsArc (FName : STRING) : ARCTYPE;
  67. VAR
  68.   ArcFile : FILE;
  69.   ArcID   : ARCTYPE;
  70.   IDarr   : Array[1..64] OF CHAR;
  71.   IDStr,
  72.   IDhex   : STRING;
  73.   Index,
  74.   BytesRead : INTEGER;
  75.  
  76. BEGIN
  77.   ArcID := NONE;  {If none of the above}
  78.   Assign (ArcFile, FName);
  79.   Reset (ArcFile,1);
  80.   IF IOResult = 0 THEN
  81.   BEGIN
  82.     BlockRead (ArcFile, IDarr, SizeOf (IDarr), BytesRead);
  83.     Close (ArcFile);
  84.  
  85.     IDStr[0] := Chr (64);
  86.     Move (IDarr[1], IDStr[1], BytesRead);
  87.     IDStrh := StrToHex (IDStr, 64);
  88.  
  89.     {ARJ SFX}
  90.     IF CheckID (1, '4D5A0A001E0000000200640FFFFF3D05800000000E0088031C0000005'+
  91.     '24A5358FFFFBA40042E89163A02B430CD218B2E02FFFF008B1E2C008EDAA390008C068E')
  92.        THEN ArcID := ARJ ELSE
  93.     IF CheckID (1, '4D5AD1000B0000000200120EFFFFCB01800000000E0035011C0000005'+
  94.     '24A5358FFFFBA62012E89163A02B430CD218B2E02FFFF008B1E2C008EDAA390008C068E')
  95.        THEN ArcID := ARJ ELSE
  96.     IF CheckID (1, '4D5AEA00240000000200F50FFFFF9106800000000E0056041C0000005'+
  97.     '24A5358FFFFBA5E052E89163A02B430CD218B2E02FFFF008B1E2C008EDAA390008C068E')
  98.        THEN ArcID := ARJ ELSE
  99.  
  100.     {LHA SFX}
  101.     IF CheckID (1, '4D5A99010400000002000010FFFFF0FF000100000001F0FF1C0000000'+
  102.     '0000000EB7920004C484127732053465820322E31334C2028632920596F7368692C2031')
  103.        THEN ArcID := LZH ELSE
  104.     IF CheckID (1, '4D5A64000400000002000010FFFFF0FF000100000001F0FF1C0000000'+
  105.     '0000000EB7920004C484127732053465820322E3133532028632920596F7368692C2031')
  106.        THEN ArcID := LZH ELSE
  107.  
  108.     {PAK SFX}
  109.     IF CheckID (1, '4D5AD3000E00060020007900FFFF8E0180070000E10900003E0000000'+
  110.     '100FB306A7200000000000000000000000000000000000000000000000000000000A605')
  111.        THEN ArcID := PAK ELSE
  112.  
  113.     {ZIP SFX}
  114.     IF CheckID (1, '4D5AEF01190000000600D10CFFFF2003000400000001F0FF1E0000000'+
  115.     '001436F7079726967687420313938392D3139393020504B5741524520496E632E20416C')
  116.        THEN ArcID := ZIP ELSE
  117.     IF CheckID (1, '4D5A76010600000002000206FFFFF0FF706700000001F0FF1E0000000'+
  118.     '0000000B87067A34E0CBF560CB9705F2BCF32C0F3AAB430CD21A3520CA12C00A3500CE8')
  119.        THEN ArcID := ZIP ELSE
  120.     IF CheckID (1, '4D5A99011F0001000600890CFFFF0000206100000001F0FF520000001'+
  121.     '411504B4C49544520436F70722E20313939302D393220504B5741524520496E632E2041')
  122.        THEN ArcID := ZIP ELSE
  123.     IF CheckID (1, '4D5ABA01060000000200890B0010F0FF1CC000000001F0FF1E0000000'+
  124.     '0000000B91CBABF9A0C2BCF32C0F3AAB430CD21A302BA892614BAE83300B8A80AE8D401')
  125.        THEN ArcID := ZIP ELSE
  126.     IF CheckID (1, '4D5AF5011E0001000600890CFFFF0000B05F00000001F0FF520000001'+
  127.     '411504B4C49544520436F70722E20313939302D393220504B5741524520496E632E2041')
  128.        THEN ArcID := ZIP ELSE
  129.  
  130.     IF NOT CheckID (1, '4D5A') THEN  { If file is .EXE, go no further. }
  131.     BEGIN
  132.  
  133.       {AIN}
  134.       IF CheckID (1, '21') AND CheckID (5, '00')  {!+?+NUL}
  135.          THEN ArcID := AIN ELSE
  136.  
  137.       {HA}
  138.       IF CheckID (1, '4841')  {HA}
  139.          THEN ArcID := HA ELSE
  140.  
  141.       {JRC}
  142.       IF CheckID (1, '4A526368697665')  {JRchive}
  143.          THEN ArcID := JRC ELSE
  144.  
  145.       {PAQ}
  146.       IF CheckID (1, '44530060')  {DS`}
  147.          THEN ArcID := PAQ ELSE
  148.  
  149.       {SQZ}
  150.       IF CheckID (1, '484C53515A')  {HLSQZ}
  151.          THEN ArcID := SQZ ELSE
  152.  
  153.       {HPACK}
  154.       IF CheckID (1, '4850414B')  {HPAK}
  155.          THEN ArcID := HPK ELSE
  156.  
  157.       {LIM}
  158.       IF CheckID (1, '4C4D1A')  {LM+ESC}
  159.          THEN ArcID := LIM ELSE
  160.  
  161.       {ZIP}
  162.       IF CheckID (1, '504B0304')  {PK..}
  163.          THEN ArcID := ZIP ELSE
  164.  
  165.       {RAR}
  166.       IF CheckID (1, '526172')  {Rar}
  167.          THEN ArcID := RAR ELSE
  168.  
  169.       {UC2}
  170.       IF CheckID (1, '5543321A')  {UC2+ESC+}
  171.          THEN ArcID := UC2 ELSE
  172.  
  173.       {ZOO - MS DOS}
  174.       IF CheckID (1, '5A4F4F')  {ZOO - only at beginning on MS-DOS machines!}
  175.          THEN ArcID := ZOO ELSE
  176.  
  177.       {ARJ}
  178.       IF CheckID (1, '60EA')  {`Ω}
  179.          THEN ArcID := ARJ ELSE
  180.  
  181.       {CODEC}
  182.       IF CheckID (1, '76FF31')  {v 1}
  183.          THEN ArcID := LIB ELSE
  184.  
  185.       {HAP/PAH}
  186.       IF CheckID (1, '91334846')  {æ3HF}
  187.          THEN ArcID := HAP ELSE
  188.  
  189.       {LHA (& LHARC?)}
  190.       IF CheckID (5, '2D6C68')  {-lh}
  191.          THEN ArcID := LZH ELSE
  192.  
  193.       {SAR}
  194.       IF CheckID (5, '204C48')  { LH *Note: SAR uses LHA v2.13 compression.}
  195.          THEN ArcID := SAR ELSE
  196.  
  197.       {PUT}
  198.       IF CheckID (5, '2D6C5A')  {-lZ *Note: PUT uses LHA v2.13 compression.}
  199.          THEN ArcID := PUT ELSE
  200.  
  201.       {LARC}
  202.       IF CheckID (5, '2D6C7A')  {-lz}
  203.          THEN ArcID := LZS ELSE
  204.  
  205.       {ZOO}
  206.       IF CheckID (41, 'DCA7C4FD')  {▄º─²}
  207.          THEN ArcID := ZOO ELSE
  208.  
  209.       {YAC}
  210.       IF CheckID (29, '5943')  {YC}
  211.          THEN ArcID := YC ELSE
  212.  
  213.       {ARC+}
  214.       IF CheckID (1, '1A14') {+ESC+}
  215.          THEN ArcID := ARC ELSE
  216.  
  217.       {HYPER}
  218.       IF ((IDStr[1] = #$1a) AND (IDStr[2] >= #$48))
  219.          THEN ArcID := HYP ELSE
  220.  
  221.       {PAK}
  222.       IF ((IDStr[1] = #$1a) AND (IDStr[2] >= #$0a))
  223.          THEN ArcID := PAK ELSE
  224.  
  225.       {ARC}
  226.       IF CheckID (1, '1A')  {+ESC+}
  227.          THEN ArcID := ARC ELSE
  228.  
  229.       {ACB}
  230.       IF CheckID (3, '80')  {Ç}
  231.          THEN ArcID := ACB ELSE
  232.  
  233.       BEGIN END;  { This satisfies the final ELSE clause. }
  234.     END;
  235.   END;
  236.   IsArc := ArcID;
  237. END;
  238.  
  239. END.
  240.